home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d10 / sas.arc / FILES.CLA < prev    next >
Encoding:
Text File  |  1990-09-17  |  10.8 KB  |  326 lines
  1. FILES         PROGRAM
  2.  
  3. REJECT_KEY   EQUATE(CTRL_ESC)
  4. ACCEPT_KEY   EQUATE(CTRL_ENTER)
  5. TRUE         EQUATE(1)
  6. FALSE         EQUATE(0)
  7.  
  8.          MAP
  9.            PROC(G_OPENFILES)
  10.          PROC(MAIN)
  11.            .
  12.          EJECT('FILE LAYOUTS')
  13. CLIENTS         FILE,PRE(CLI),CREATE,RECLAIM
  14. CLIENT_KEY     KEY(CLI:CLIENT),DUP,NOCASE,OPT
  15. COMMENTS       MEMO(490)             !Comments
  16. RECORD           RECORD
  17. CLIENT         STRING(32)             !Client Name
  18. ORDEREDBY     STRING(32)             !Ordered By
  19. ADD1         STRING(32)             !Address #1
  20. ADD2         STRING(32)             !Address #2
  21. CITY         STRING(18)             !City
  22. STATE         STRING(2)             !State
  23. ZIP         DECIMAL(9,0)             !Zip Code
  24. DAYPHONE     DECIMAL(10,0)             !Day Phone
  25. EXTENSION     STRING(10)             !Extension
  26. EVEPHONE     DECIMAL(10,0)             !Eve Phone
  27. FAXPHONE     DECIMAL(10,0)             !Fax Phone
  28.          . .
  29.          GROUP,OVER(CLI:COMMENTS)
  30. CLI_MEMO_ROW   STRING(70),DIM(7)
  31.          .
  32.  
  33. INVNTORY     FILE,PRE(INV),CREATE,RECLAIM
  34. PN_KEY           KEY(INV:PARTNUM),NOCASE,OPT
  35. COMMENTS       MEMO(96)                 !Comments about Inventory Items
  36. RECORD           RECORD
  37. PARTNUM         STRING(16)             !Part Number
  38. PRODDESC     STRING(30)             !Product Description
  39. COST         REAL                 !Item Cost
  40. MFGRETAIL     REAL                 !MFG Retail Price
  41. CLASS1         REAL                 !Price Class 1
  42. CLASS2         REAL                 !Price Class 2
  43. CLASS3         REAL                 !Price Class 3
  44. TAXABLE         STRING(3)             !Taxable Flag
  45. VENDOR         STRING(32)             !Vendor Name
  46.          . .
  47.          GROUP,OVER(INV:COMMENTS)
  48. INV_MEMO_ROW   STRING(32),DIM(3)
  49.          .
  50.  
  51. ORDERS         FILE,PRE(ORD),CREATE,RECLAIM
  52. ORDER_KEY      KEY(ORD:ORDER_NUM),NOCASE,OPT
  53. CLIENT_KEY     KEY(ORD:CLIENT),DUP,NOCASE,OPT
  54. TYPE_KEY       KEY(ORD:TYPE),DUP,NOCASE,OPT
  55. DATE_KEY       KEY(ORD:DATE),DUP,NOCASE,OPT
  56. NOTES           MEMO(87)                 !Order Notes
  57. RECORD           RECORD
  58. ORDER_NUM     LONG                 !Order Number
  59. CLIENT         STRING(32)             !Client Name
  60. TYPE         STRING(9)             !Order Type
  61. DATE         LONG                 !Order Date
  62. SALESPERSON     STRING(32)             !Salesperson
  63. ORDERREF     STRING(32)             !Order Reference
  64. PRICECLASS     BYTE                 !Price Class
  65. TAXPCT         REAL                 !Tax Percentage
  66. TAX         REAL                 !Tax on Order
  67. PAYMETHOD     STRING(20)             !Method of Payment
  68. TERMS         STRING(13)             !Payment Terms
  69. PO         STRING(25)             !Purchase Order Number
  70. CCNUM         STRING(25)             !Credit Card Number
  71. EXPDATE         STRING(10)             !Credit Card Expiration Date
  72. SURCHARGE     REAL                 !Credit Card Surcharge
  73. SHIPTO         STRING(32)             !Ship To - Name
  74. SHIPADD1     STRING(32)             !Ship To - Address #1
  75. SHIPADD2     STRING(32)             !Ship To - Address #2
  76. SHIPCITY     STRING(18)             !Ship To - City
  77. SHIPSTATE     STRING(2)             !Ship To - State
  78. SHIPZIP         DECIMAL(9,0)             !Ship To - Zip Code
  79. SHIPATTN     STRING(26)             !Ship To - Attention
  80. COST         REAL                 !Order Cost
  81. SUBTOTAL     REAL                 !Order Subtotal
  82.          . .
  83.          GROUP,OVER(ORD:NOTES)
  84. ORD_MEMO_ROW   STRING(29),DIM(3)
  85.          .
  86.  
  87. ITEM_ORD     FILE,PRE(ITE),CREATE
  88. ORD_KEY           KEY(ITE:ORDER_NUM),DUP,NOCASE,OPT
  89. RECORD           RECORD
  90. ORDER_NUM     LONG                 !Order Number
  91. PART_NUM     STRING(16)             !Part Number
  92. QTY         SHORT                 !Quantity
  93. DEFAULTPRICE     REAL                 !Default Item Price
  94. ORDERPRICE     REAL                 !Order Price
  95.          . .
  96.  
  97. PAYMETHD     FILE,PRE(PAY),CREATE,RECLAIM
  98. METHOD_KEY     KEY(PAY:METHOD_PAY),NOCASE,OPT
  99. RECORD           RECORD
  100. METHOD_PAY     STRING(20)             !Method Of Payment
  101.          . .
  102.  
  103. TERMS         FILE,PRE(TER),CREATE,RECLAIM
  104. TERM_KEY       KEY(TER:TERMS),NOCASE,OPT
  105. RECORD           RECORD
  106. TERMS         STRING(13)             !Terms of Order
  107.          . .
  108.  
  109. VENDORS         FILE,PRE(VEN),CREATE,RECLAIM
  110. VEN_KEY           KEY(VEN:VENDOR),DUP,NOCASE,OPT
  111. COMMENTS       MEMO(350)             !Comments
  112. RECORD           RECORD
  113. VENDOR         STRING(32)             !Vendor Name
  114. ADD1         STRING(32)             !Address #1
  115. ADD2         STRING(32)             !Address #2
  116. CITY         STRING(18)             !City
  117. STATE         STRING(2)             !State
  118. ZIP         DECIMAL(9,0)             !Zip Code
  119. CONTACT         STRING(32)             !Contact Person
  120. DAYPHONE     DECIMAL(10,0)             !Phone Number
  121. EXTENSION     STRING(10)             !Extension
  122. EVEPHONE     DECIMAL(10,0)             !Phone Number #2
  123. FAXPHONE     DECIMAL(10,0)             !Fax Phone Number
  124. ACCTNUM         STRING(20)             !Account Number
  125. TERMS         STRING(32)             !Terms
  126.          . .
  127.          GROUP,OVER(VEN:COMMENTS)
  128. VEN_MEMO_ROW   STRING(70),DIM(5)
  129.          .
  130.  
  131. COMPANY         FILE,PRE(COM),RECLAIM
  132. RECORD           RECORD
  133. COMPANY         STRING(32)
  134. ADD1         STRING(32)
  135. ADD2         STRING(32)
  136. CITY         STRING(18)
  137. STATE         STRING(2)
  138. ZIP         DECIMAL(9,0)
  139. PHONE         DECIMAL(10,0)
  140. TAXPCT         REAL
  141. COM1         STRING(60)
  142. COM2         STRING(60)
  143. COM3         STRING(60)
  144. FIN3         DECIMAL(10,10)
  145. FIN4         DECIMAL(10,10)
  146. FIN5         DECIMAL(10,10)
  147. C1MARGIN     REAL                 !Class 1 Default Margin
  148. C2MARGIN     REAL                 !Class 2 Default Margin
  149. C3MARGIN     REAL                 !Class 3 Default MArgin
  150.          . .
  151.  
  152.          EJECT('GLOBAL MEMORY VARIABLES')
  153. ACTION         SHORT                 !0 = NO ACTION
  154.                          !1 = ADD RECORD
  155.                          !2 = CHANGE RECORD
  156.                          !3 = DELETE RECORD
  157.                          !4 = LOOKUP FIELD
  158.          GROUP,PRE(MEM)
  159. MESSAGE           STRING(30)             !Global Message Area
  160. PAGE           SHORT                 !Report Page Number
  161. LINE           SHORT                 !Report Line Number
  162. DEVICE           STRING(30)             !Report Device Name
  163.          .
  164.  
  165.          EJECT('CODE SECTION')
  166.   CODE
  167.   SETHUE(7,0)                     !SET WHITE ON BLACK
  168.   BLANK                         !  AND BLANK
  169.   G_OPENFILES                     !OPEN OR CREATE FILES
  170.   SETHUE()                     !    THE SCREEN
  171.   MAIN
  172.   RETURN                     !EXIT TO DOS
  173.  
  174. G_OPENFILES  PROCEDURE                 !OPEN FILES & CHECK FOR ERROR
  175.   CODE
  176.   SHOW(25,1,CENTER('OPENING FILE: ' & 'CLIENTS',80)) !DISPLAY FILE NAME
  177.   OPEN(CLIENTS)                     !OPEN THE FILE
  178.   IF ERROR()                     !OPEN RETURNED AN ERROR
  179.     CASE ERRORCODE()                 ! CHECK FOR SPECIFIC ERROR
  180.     OF 46                     !  KEYS NEED TO BE REQUILT
  181.       SETHUE(0,7)                 !  BLACK ON WHITE
  182.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR CLIENTS',80)) !INDICATE MSG
  183.       BUILD(CLIENTS)                 !  CALL THE BUILD PROCEDURE
  184.       SETHUE(7,0)                 !  WHITE ON BLACK
  185.       BLANK(25,1,1,80)                 !  BLANK THE MESSAGE
  186.     OF 2                     !IF NOT FOUND,
  187.       CREATE(CLIENTS)                 ! CREATE
  188.     ELSE                     ! ANY OTHER ERROR
  189.       LOOP;STOP('CLIENTS: ' & ERROR()).         !  STOP EXECUTION
  190.   . .
  191.  
  192.   SHOW(25,1,CENTER('OPENING FILE: ' & 'INVNTORY',80)) !DISPLAY FILE NAME
  193.   OPEN(INVNTORY)                 !OPEN THE FILE
  194.   IF ERROR()                     !OPEN RETURNED AN ERROR
  195.     CASE ERRORCODE()                 ! CHECK FOR SPECIFIC ERROR
  196.     OF 46                     !  KEYS NEED TO BE REQUILT
  197.       SETHUE(0,7)                 !  BLACK ON WHITE
  198.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR INVNTORY',80)) !INDICATE MSG
  199.       BUILD(INVNTORY)                 !  CALL THE BUILD PROCEDURE
  200.       SETHUE(7,0)                 !  WHITE ON BLACK
  201.       BLANK(25,1,1,80)                 !  BLANK THE MESSAGE
  202.     OF 2                     !IF NOT FOUND,
  203.       CREATE(INVNTORY)                 ! CREATE
  204.     ELSE                     ! ANY OTHER ERROR
  205.       LOOP;STOP('INVNTORY: ' & ERROR()).     !  STOP EXECUTION
  206.   . .
  207.  
  208.   SHOW(25,1,CENTER('OPENING FILE: ' & 'ORDERS',80)) !DISPLAY FILE NAME
  209.   OPEN(ORDERS)                     !OPEN THE FILE
  210.   IF ERROR()                     !OPEN RETURNED AN ERROR
  211.     CASE ERRORCODE()                 ! CHECK FOR SPECIFIC ERROR
  212.     OF 46                     !  KEYS NEED TO BE REQUILT
  213.       SETHUE(0,7)                 !  BLACK ON WHITE
  214.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR ORDERS',80)) !INDICATE MSG
  215.       BUILD(ORDERS)                 !  CALL THE BUILD PROCEDURE
  216.       SETHUE(7,0)                 !  WHITE ON BLACK
  217.       BLANK(25,1,1,80)                 !  BLANK THE MESSAGE
  218.     OF 2                     !IF NOT FOUND,
  219.       CREATE(ORDERS)                 ! CREATE
  220.     ELSE                     ! ANY OTHER ERROR
  221.       LOOP;STOP('ORDERS: ' & ERROR()).         !  STOP EXECUTION
  222.   . .
  223.  
  224.   SHOW(25,1,CENTER('OPENING FILE: ' & 'ITEM_ORD',80)) !DISPLAY FILE NAME
  225.   OPEN(ITEM_ORD)                 !OPEN THE FILE
  226.   IF ERROR()                     !OPEN RETURNED AN ERROR
  227.     CASE ERRORCODE()                 ! CHECK FOR SPECIFIC ERROR
  228.     OF 46                     !  KEYS NEED TO BE REQUILT
  229.       SETHUE(0,7)                 !  BLACK ON WHITE
  230.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR ITEM_ORD',80)) !INDICATE MSG
  231.       BUILD(ITEM_ORD)                 !  CALL THE BUILD PROCEDURE
  232.       SETHUE(7,0)                 !  WHITE ON BLACK
  233.       BLANK(25,1,1,80)                 !  BLANK THE MESSAGE
  234.     OF 2                     !IF NOT FOUND,
  235.       CREATE(ITEM_ORD)                 ! CREATE
  236.     ELSE                     ! ANY OTHER ERROR
  237.       LOOP;STOP('ITEM_ORD: ' & ERROR()).     !  STOP EXECUTION
  238.   . .
  239.  
  240.   SHOW(25,1,CENTER('OPENING FILE: ' & 'PAYMETHD',80)) !DISPLAY FILE NAME
  241.   OPEN(PAYMETHD)                 !OPEN THE FILE
  242.   IF ERROR()                     !OPEN RETURNED AN ERROR
  243.     CASE ERRORCODE()                 ! CHECK FOR SPECIFIC ERROR
  244.     OF 46                     !  KEYS NEED TO BE REQUILT
  245.       SETHUE(0,7)                 !  BLACK ON WHITE
  246.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR PAYMETHD',80)) !INDICATE MSG
  247.       BUILD(PAYMETHD)                 !  CALL THE BUILD PROCEDURE
  248.       SETHUE(7,0)                 !  WHITE ON BLACK
  249.       BLANK(25,1,1,80)                 !  BLANK THE MESSAGE
  250.     OF 2                     !IF NOT FOUND,
  251.       CREATE(PAYMETHD)                 ! CREATE
  252.     ELSE                     ! ANY OTHER ERROR
  253.       LOOP;STOP('PAYMETHD: ' & ERROR()).     !  STOP EXECUTION
  254.   . .
  255.  
  256.   SHOW(25,1,CENTER('OPENING FILE: ' & 'TERMS',80)) !DISPLAY FILE NAME
  257.   OPEN(TERMS)                     !OPEN THE FILE
  258.   IF ERROR()                     !OPEN RETURNED AN ERROR
  259.     CASE ERRORCODE()                 ! CHECK FOR SPECIFIC ERROR
  260.     OF 46                     !  KEYS NEED TO BE REQUILT
  261.       SETHUE(0,7)                 !  BLACK ON WHITE
  262.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR TERMS',80)) !INDICATE MSG
  263.       BUILD(TERMS)                 !  CALL THE BUILD PROCEDURE
  264.       SETHUE(7,0)                 !  WHITE ON BLACK
  265.       BLANK(25,1,1,80)                 !  BLANK THE MESSAGE
  266.     OF 2                     !IF NOT FOUND,
  267.       CREATE(TERMS)                 ! CREATE
  268.     ELSE                     ! ANY OTHER ERROR
  269.       LOOP;STOP('TERMS: ' & ERROR()).         !  STOP EXECUTION
  270.   . .
  271.  
  272.   SHOW(25,1,CENTER('OPENING FILE: ' & 'VENDORS',80)) !DISPLAY FILE NAME
  273.   OPEN(VENDORS)                     !OPEN THE FILE
  274.   IF ERROR()                     !OPEN RETURNED AN ERROR
  275.     CASE ERRORCODE()                 ! CHECK FOR SPECIFIC ERROR
  276.     OF 46                     !  KEYS NEED TO BE REQUILT
  277.       SETHUE(0,7)                 !  BLACK ON WHITE
  278.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR VENDORS',80)) !INDICATE MSG
  279.       BUILD(VENDORS)                 !  CALL THE BUILD PROCEDURE
  280.       SETHUE(7,0)                 !  WHITE ON BLACK
  281.       BLANK(25,1,1,80)                 !  BLANK THE MESSAGE
  282.     OF 2                     !IF NOT FOUND,
  283.       CREATE(VENDORS)                 ! CREATE
  284.     ELSE                     ! ANY OTHER ERROR
  285.       LOOP;STOP('VENDORS: ' & ERROR()).         !  STOP EXECUTION
  286.   . .
  287.  
  288.   SHOW(25,1,CENTER('OPENING FILE: ' & 'COMPANY',80)) !DISPLAY FILE NAME
  289.   OPEN(COMPANY)                     !OPEN THE FILE
  290.   IF ERROR()                     !OPEN RETURNED AN ERROR
  291.     CASE ERRORCODE()                 ! CHECK FOR SPECIFIC ERROR
  292.     OF 46                     !  KEYS NEED TO BE REQUILT
  293.       SETHUE(0,7)                 !  BLACK ON WHITE
  294.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR COMPANY',80)) !INDICATE MSG
  295.       BUILD(COMPANY)                 !  CALL THE BUILD PROCEDURE
  296.       SETHUE(7,0)                 !  WHITE ON BLACK
  297.       BLANK(25,1,1,80)                 !  BLANK THE MESSAGE
  298.     ELSE                     ! ANY OTHER ERROR
  299.       LOOP;STOP('COMPANY: ' & ERROR()).         !  STOP EXECUTION
  300.   . .
  301.  
  302.   BLANK                         !BLANK THE SCREEN
  303.  
  304.  
  305. MAIN         PROCEDURE
  306.  
  307.     CODE
  308.     STREAM(ORDERS)
  309.     SET(ORDERS)
  310.     LOOP UNTIL EOF(ORDERS)
  311.     NEXT(ORDERS)
  312.     ORD:TAX=(ORD:TAXPCT/100)*ORD:SUBTOTAL
  313.     PUT(ORDERS)
  314.     .
  315.  
  316.     STREAM(INVNTORY)
  317.     SET(INVNTORY)
  318.     LOOP UNTIL EOF(INVNTORY)
  319.     NEXT(INVNTORY)
  320.     INV:TAXABLE='YES'
  321.     INV:CLASS3=INV:CLASS2
  322.     PUT(INVNTORY)
  323.     .
  324.     RETURN
  325.  
  326.